home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbuser.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-08  |  20.6 KB  |  523 lines
  1. (*===========================================================================*)
  2. (* User task                                                                 *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1991, 1992 by H. Roy Engehausen.  All rights      *)
  5. (*   reserved.                                                               *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$O+}
  10.  
  11. UNIT BBUSER;
  12.  
  13. INTERFACE
  14.  
  15. PROCEDURE user_start;
  16.  
  17. IMPLEMENTATION
  18.  
  19. USES
  20.   bbanswer,
  21.   bbauth,
  22.   bbconv,
  23.   bbdummy,
  24.   bblc,
  25.   bbmdata,
  26.   bbmess,
  27.   bbmf,
  28.   bbmisc,
  29.   bbmisc2,
  30.   bbrdata,
  31.   bbreg,
  32.   bbsdata,
  33.   bbsess,
  34.   bbstarl,
  35.   bbstr,
  36.   bbtask,
  37.   bbtime,
  38.   bbucmd,
  39.   bbuserno,
  40.   bbwin;
  41.  
  42. (*===========================================================================*)
  43. (* This is the main user task                                                *)
  44. (*===========================================================================*)
  45.  
  46. PROCEDURE user_start;
  47.  
  48.   VAR
  49.  
  50.     bb_sign_on_done : BOOLEAN;
  51.     user_reject     : BOOLEAN;
  52.     star_l_done     : BOOLEAN;
  53.     cmd_string      : STRING;
  54.     link_restart    : BOOLEAN;
  55.  
  56.   LABEL opr_want_talk;
  57.   LABEL link_loop;
  58.  
  59.   (*=========================================================================*)
  60.   (* This subroutine does *** LINK stuff                                     *)
  61.   (*=========================================================================*)
  62.  
  63.   PROCEDURE process_star_link;
  64.  
  65.     BEGIN;
  66.  
  67.       (*---------------------------------------------------------------*)
  68.       (* Call the *** LINK procedure                                   *)
  69.       (*---------------------------------------------------------------*)
  70.  
  71.       link_restart := star_link(cmd_string);
  72.  
  73.       (*---------------------------------------------------------------*)
  74.       (* If it failed, end the session                                 *)
  75.       (*---------------------------------------------------------------*)
  76.  
  77.       IF NOT link_restart THEN
  78.         end_session(FALSE);
  79.  
  80.     END;
  81.  
  82.   (*=========================================================================*)
  83.   (* User security                                                           *)
  84.   (*=========================================================================*)
  85.  
  86.   PROCEDURE user_secure_check;
  87.     BEGIN;
  88.  
  89.       WITH active_tcb^.uid_data DO
  90.         BEGIN;
  91.  
  92.           (*-----------------------------------------------------------------*)
  93.           (* Assume everything is bad                                        *)
  94.           (*-----------------------------------------------------------------*)
  95.  
  96.           active_tcb^.error_sw := TRUE;
  97.  
  98.           (*-----------------------------------------------------------------*)
  99.           (* Build the task access control area                              *)
  100.           (*-----------------------------------------------------------------*)
  101.  
  102.           active_tcb^.tcb_access_mode.access_flags :=
  103.                                     user_access.access_flags
  104.                                     AND active_port^.dflt_access.access_flags;
  105.  
  106.           (*-----------------------------------------------------------------*)
  107.           (* Drop user if excluded                                           *)
  108.           (*-----------------------------------------------------------------*)
  109.  
  110.           IF (user_flag AND user_f_exclude) <> 0 THEN
  111.  
  112.             EXIT;
  113.  
  114.           (*-----------------------------------------------------------------*)
  115.           (* Drop user if class not allowed on this port (remote sysops are  *)
  116.           (* exempt from this rule)                                          *)
  117.           (*-----------------------------------------------------------------*)
  118.  
  119.           IF (user_class < active_port^.port_allow)
  120.                                    AND ((user_flag AND user_f_sysop) = 0) THEN
  121.             EXIT;
  122.  
  123.           (*-----------------------------------------------------------------*)
  124.           (* Assume everything after this is OK.                             *)
  125.           (*-----------------------------------------------------------------*)
  126.  
  127.           active_tcb^.error_sw := FALSE;
  128.           active_tcb^.tcb_error_reason := 0;
  129.  
  130.           (*-----------------------------------------------------------------*)
  131.           (* Should user authenticate now?  If not we are done               *)
  132.           (*-----------------------------------------------------------------*)
  133.  
  134.           IF (active_tcb^.tcb_access_mode.access_flags
  135.                                                    AND access_f_user) = 0 THEN
  136.             EXIT;
  137.  
  138.           (*-----------------------------------------------------------------*)
  139.           (* If this is a BBS, skip the authentication now.  Catch it later  *)
  140.           (* in the command processor                                        *)
  141.           (*-----------------------------------------------------------------*)
  142.  
  143.           IF (user_flag AND (user_f_bbs OR user_f_pbbs)) <> 0 THEN
  144.             EXIT;
  145.  
  146.           (*-----------------------------------------------------------------*)
  147.           (* Call the authenticator                                          *)
  148.           (*-----------------------------------------------------------------*)
  149.  
  150.           user_auth(cmd_string);
  151.  
  152.           (*-----------------------------------------------------------------*)
  153.           (* Set the result code                                             *)
  154.           (*-----------------------------------------------------------------*)
  155.  
  156.           IF NOT active_tcb^.error_sw THEN
  157.             BEGIN;
  158.               active_tcb^.tcb_access_ok   := TRUE;
  159.               active_tcb^.tcb_sysop_pw_ok := TRUE;
  160.                                        (* We can always turn this on even if *)
  161.                                        (* user is not authorized since he    *)
  162.                                        (* can't get into remote sysop status *)
  163.                                        (* without the proper bit             *)
  164.             END;
  165.  
  166.         END;
  167.  
  168.     END;
  169.  
  170.   (*=========================================================================*)
  171.   (* Check the access                                                        *)
  172.   (*=========================================================================*)
  173.  
  174.   PROCEDURE access_test;
  175.     BEGIN;
  176.  
  177.       (*---------------------------------------------------------------------*)
  178.       (* Test for BBS                                                        *)
  179.       (*---------------------------------------------------------------------*)
  180.  
  181.       IF (active_tcb^.uid_data.user_flag
  182.                                      AND (user_f_bbs OR user_f_pbbs)) <> 0 THEN
  183.         BEGIN;
  184.  
  185.           (*-----------------------------------------------------------------*)
  186.           (* If all they want is reverse forward, let them                   *)
  187.           (*-----------------------------------------------------------------*)
  188.  
  189.           IF cmd_string = 'F>' THEN
  190.             EXIT;
  191.  
  192.           EXIT;
  193.  
  194.         END;
  195.  
  196.       IF cmd_string[1] <> 'S' THEN
  197.         EXIT;
  198.  
  199.  
  200.     END;
  201.  
  202.   (*=========================================================================*)
  203.   (* This subroutine decodes the command                                     *)
  204.   (*=========================================================================*)
  205.  
  206.   PROCEDURE user_command_decode;
  207.  
  208.     BEGIN;
  209.  
  210.       (*---------------------------------------------------------------------*)
  211.       (* Handle the sign on for an advanced bbs                              *)
  212.       (*      This is an incoming command for the following format:          *)
  213.       (*          [xxxxxxx-fff]                                              *)
  214.       (*---------------------------------------------------------------------*)
  215.  
  216.       WITH active_tcb^ DO
  217.         IF (cmd_string[1] = '[') AND (NOT bb_sign_on_done) THEN
  218.  
  219.           BEGIN;
  220.  
  221.             (*---------------------------------------------------------------*)
  222.             (* Process the SID if this is one                                *)
  223.             (*---------------------------------------------------------------*)
  224.  
  225.             process_sid(@cmd_string);
  226.             bb_sign_on_done := TRUE;
  227.             star_l_done     := FALSE;
  228.             active_port^.modem_crlf := FALSE;
  229.  
  230.             EXIT;
  231.  
  232.           END;
  233.  
  234.       (*---------------------------------------------------------------------*)
  235.       (* Handle *** LINKED                                                   *)
  236.       (*---------------------------------------------------------------------*)
  237.  
  238.       IF (NOT star_l_done)
  239.                           AND substr_compare(cmd_string, 1, '*** LINKED') THEN
  240.         BEGIN;
  241.           process_star_link;
  242.           EXIT;
  243.         END;
  244.  
  245.       (*---------------------------------------------------------------------*)
  246.       (* If no authentication at this point, see if an allowed command.      *)
  247.       (* We will always allow a "@".  We may not allow an "S" sometimes      *)
  248.       (*---------------------------------------------------------------------*)
  249.  
  250.       IF NOT active_tcb^.tcb_access_ok AND (cmd_string[1] <> '@') THEN
  251.         BEGIN;
  252.           access_test;
  253.           IF active_tcb^.error_sw THEN
  254.             EXIT;
  255.         END;
  256.  
  257.       (*---------------------------------------------------------------------*)
  258.       (* Normal user command                                                 *)
  259.       (*---------------------------------------------------------------------*)
  260.  
  261.       bb_sign_on_done := TRUE;
  262.       star_l_done     := TRUE;
  263.       user_command(cmd_string);
  264.  
  265.     END;
  266.  
  267.   (*=========================================================================*)
  268.   (* The actual user task                                                    *)
  269.   (*=========================================================================*)
  270.  
  271.   BEGIN;
  272.  
  273.     (*-----------------------------------------------------------------------*)
  274.     (* Make sure we show connected properly                                  *)
  275.     (*-----------------------------------------------------------------------*)
  276.  
  277.     active_port^.connected^[active_tcb^.channel] := active_tcb;
  278.  
  279.     (*-----------------------------------------------------------------------*)
  280.     (* If a modem then we have an incoming call                              *)
  281.     (*-----------------------------------------------------------------------*)
  282.  
  283.     IF active_port^.port_type = port_modem THEN
  284.       answer_modem;
  285.  
  286.     (*-----------------------------------------------------------------------*)
  287.     (* Show that we are a user task                                          *)
  288.     (*-----------------------------------------------------------------------*)
  289.  
  290.     active_tcb^.tcb_type := th_user;
  291.  
  292.     (*-----------------------------------------------------------------------*)
  293.     (* Initialize the link                                                   *)
  294.     (*-----------------------------------------------------------------------*)
  295.  
  296.     link_restart := FALSE;
  297.  
  298.     link_start;
  299.  
  300.     (*-----------------------------------------------------------------------*)
  301.     (* If this is a modem then maybe we have authenticated                   *)
  302.     (*-----------------------------------------------------------------------*)
  303.  
  304.     IF (active_port^.port_type = port_modem)
  305.                                   AND (active_tcb^.uid_data.user_pw <> '') THEN
  306.       BEGIN;
  307.         active_tcb^.tcb_sysop_pw_ok := TRUE;
  308.         active_tcb^.tcb_access_ok   := TRUE;
  309.       END;
  310.  
  311.     (*-----------------------------------------------------------------------*)
  312.     (* This point is used when we change call signs in response to           *)
  313.     (* *** LINKED, etc                                                       *)
  314.     (*-----------------------------------------------------------------------*)
  315.  
  316. link_loop:
  317.  
  318.     WITH active_tcb^.uid_data DO
  319.       BEGIN;
  320.  
  321.         (*-------------------------------------------------------------------*)
  322.         (* Set the attributes                                                *)
  323.         (*-------------------------------------------------------------------*)
  324.  
  325.         IF (user_flag AND (user_f_bbs OR user_f_pbbs)) <> 0 THEN
  326.           BEGIN;
  327.             bb_sign_on_done := FALSE;
  328.             star_l_done     := link_restart;
  329.           END
  330.         ELSE
  331.           BEGIN;
  332.             bb_sign_on_done := TRUE;
  333.             star_l_done     := TRUE;
  334.           END;
  335.  
  336.         link_restart := FALSE;
  337.  
  338.         (*-------------------------------------------------------------------*)
  339.         (* Check for reject because of emergency mode                        *)
  340.         (*-------------------------------------------------------------------*)
  341.  
  342.         user_reject := active_port^.port_operate_mode.mode_e_users
  343.                                       AND opt_block.operate_mode.mode_e_users
  344.                                       AND ((user_flag AND user_f_emerg) = 0);
  345.  
  346.         (*-------------------------------------------------------------------*)
  347.         (* If emode reject, give user a chance if desired                    *)
  348.         (*-------------------------------------------------------------------*)
  349.  
  350.         IF user_reject AND active_port^.port_operate_mode.mode_user_change
  351.                          AND opt_block.operate_mode.mode_user_change THEN
  352.           BEGIN;
  353.             call_switch(cmd_string);
  354.             GOTO link_loop;
  355.           END;
  356.  
  357.         (*-------------------------------------------------------------------*)
  358.         (* Drop user emergency mode and user is not authorized or            *)
  359.         (* not emergency mode and user is not secure                         *)
  360.         (*-------------------------------------------------------------------*)
  361.  
  362.         IF NOT active_port^.port_operate_mode.mode_e_users THEN
  363.           BEGIN;
  364.             user_secure_check;
  365.             user_reject := active_tcb^.error_sw;
  366.           END;
  367.  
  368.         IF user_reject THEN
  369.           BEGIN;
  370.             send_message(message_not_on_port);
  371.             end_session(FALSE);
  372.           END;
  373.  
  374.         (*-------------------------------------------------------------------*)
  375.         (* Sign on for "advanced BBS"                                        *)
  376.         (*-------------------------------------------------------------------*)
  377.  
  378.         IF ((user_flag AND (user_f_bbs OR user_f_pbbs)) <> 0)
  379.                                           OR opt_block.opt_send_sid_alwys THEN
  380.           send_tnc_data_str(this_bbs_handshake + cr);
  381.  
  382.       END;
  383.  
  384.     (*-----------------------------------------------------------------------*)
  385.     (* Send the sign on message                                              *)
  386.     (*-----------------------------------------------------------------------*)
  387.  
  388.     IF active_port^.port_type = port_modem THEN
  389.       send_message(message_signon_modem)
  390.     ELSE
  391.       send_message(message_signon);
  392.  
  393.     (*-----------------------------------------------------------------------*)
  394.     (* If not a special user, then give signals                              *)
  395.     (*-----------------------------------------------------------------------*)
  396.  
  397.     IF active_tcb^.uid_data.user_class <= user_c_eu THEN
  398.       BEGIN;
  399.  
  400.         (*-------------------------------------------------------------------*)
  401.         (* Must register now?                                                *)
  402.         (*-------------------------------------------------------------------*)
  403.  
  404.         IF (active_tcb^.uid_data.user_class <= user_c_uu)
  405.                                       AND active_port^.port_force_register THEN
  406.           BEGIN;
  407.             send_message(message_must_register);
  408.             register_cmd('N');
  409.             IF active_tcb^.error_sw THEN
  410.               end_session(FALSE);
  411.           END;
  412.  
  413.         (*-------------------------------------------------------------------*)
  414.         (* Reregister?                                                       *)
  415.         (*-------------------------------------------------------------------*)
  416.  
  417.         IF (((user_f_bbs OR user_f_pbbs OR user_f_sysop OR user_f_adrchg)
  418.                                        AND active_tcb^.uid_data.user_flag) = 0)
  419.               AND ((current_day_time - opt_block.home_expires)
  420.                                        >  active_tcb^.uid_data.user_n_time)
  421.               AND (LENGTH(opt_block.wp_bb_sign) <> 0) THEN
  422.           send_message(message_reregister);
  423.  
  424.         (*-------------------------------------------------------------------*)
  425.         (* Unread mail?                                                      *)
  426.         (*-------------------------------------------------------------------*)
  427.  
  428.         IF find_mail('R') THEN
  429.           send_message(message_unread);
  430.  
  431.         (*-------------------------------------------------------------------*)
  432.         (* Read mail?                                                        *)
  433.         (*-------------------------------------------------------------------*)
  434.  
  435.         IF find_mail('Q') THEN
  436.           send_message(message_unkill_read);
  437.  
  438.       END;
  439.  
  440.     (*-----------------------------------------------------------------------*)
  441.     (* Main loop.... We never leave                                          *)
  442.     (*-----------------------------------------------------------------------*)
  443.  
  444.     WHILE TRUE DO
  445.       BEGIN;
  446.  
  447.         (*-------------------------------------------------------------------*)
  448.         (* If operator is going to talk then do it                           *)
  449.         (*-------------------------------------------------------------------*)
  450.  
  451. opr_want_talk:
  452.  
  453.         WITH active_tcb^ DO
  454.           IF tcb_opr_talk THEN
  455.             BEGIN;
  456.               window := window_operator;
  457.               send_message(message_o_talk_to_u);
  458.               converse_talk_loop;
  459.               window := window_connect;
  460.               send_message(message_bbs_mode);
  461.             END;
  462.  
  463.         (*-------------------------------------------------------------------*)
  464.         (* Clear the error switch                                            *)
  465.         (*-------------------------------------------------------------------*)
  466.  
  467.         active_tcb^.error_sw := FALSE;
  468.  
  469.         (*-------------------------------------------------------------------*)
  470.         (* Send prompt                                                       *)
  471.         (*-------------------------------------------------------------------*)
  472.  
  473.         send_message(message_prompt);
  474.         send_flush;
  475.         task_switch;
  476.  
  477.         (*-------------------------------------------------------------------*)
  478.         (* Wait for something to happen                                      *)
  479.         (*-------------------------------------------------------------------*)
  480.  
  481.         user_loop;
  482.  
  483.         (*-------------------------------------------------------------------*)
  484.         (* See if operator wants something                                   *)
  485.         (*-------------------------------------------------------------------*)
  486.  
  487.         IF active_tcb^.tcb_opr_talk THEN
  488.           GOTO opr_want_talk;
  489.  
  490.         (*-------------------------------------------------------------------*)
  491.         (* Response arrived so get it                                        *)
  492.         (*-------------------------------------------------------------------*)
  493.  
  494.         cmd_string := read_tnc_data_str;
  495.  
  496.         (*-------------------------------------------------------------------*)
  497.         (* Process the user's command                                        *)
  498.         (*-------------------------------------------------------------------*)
  499.  
  500.         user_command_decode;
  501.  
  502.         (*-------------------------------------------------------------------*)
  503.         (* Restart the link if *** LINK was done                             *)
  504.         (*-------------------------------------------------------------------*)
  505.  
  506.         IF link_restart THEN
  507.           GOTO link_loop;
  508.  
  509.         (*-------------------------------------------------------------------*)
  510.         (* If this is a BBS and an error has occurred, dump the session.     *)
  511.         (*-------------------------------------------------------------------*)
  512.  
  513.         WITH active_tcb^ DO
  514.           IF error_sw AND (uid_data.user_class = user_c_bu) AND
  515.                                    opt_block.opt_kill_bbs_error THEN
  516.             end_session(FALSE);
  517.  
  518.       END; (*----- End main loop --------------------------------------------*)
  519.  
  520.   END;
  521.  
  522. END.
  523.